perm filename MAIL[NEW,LSP]  blob 
sn#531337 filedate 1980-08-21 generic text, type C, neo UTF8
 
COMMENT ā   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Mail for Maclisp.   Derek Oppen 1978.
C00004 ENDMK
Cā;
;;; Mail for Maclisp.   Derek Oppen 1978.
(DEFPROP MAIL
 (LAMBDA (L)
  (PROG (DEST MESSAGE)
        (COND 
		((NULL L) 
		        (PRINC (QUOTE |Destination?  (Any valid MAIL destination list surrounded by /"s)|))
			(TERPRI)
			(SETQ DEST (READ)))
		(T (SETQ DEST (EVAL(CAR L))) (SETQ L (CDR L))))
        (COND 
		((NULL L) 
			(PRINC (QUOTE |Message?  (surrounded by /"s)|)) 
			(TERPRI)
			(SETQ MESSAGE (READ)))
		(T (SETQ MESSAGE (EVAL(CAR L)))))
        (MAIL1 DEST MESSAGE)
        (TERPRI)
        (RETURN (QUOTE (Message sent to MAIL)))))
FEXPR)
(DEFUN MAIL1 (DEST MESSAGE)
	(APPLY 'UWRITE '(DSK (RMD SYS)))
	((lambda(ār āw)
	  (PRINC '|MAIL//SUBJEC |)
	  (PRINC DEST)
	  (TERPRI)
	  (PRINC(ASCII(+ 6 6)))
	  (PRINC '|From |)
	  (PRINC (CADR (STATUS UNAME)))
	  (PRINC '| via maclsp|)
	  (TERPRI)
	  (TERPRI)
	  (PRINC MESSAGE)
	  (TERPRI)
	  (TERPRI)
	  (APPLY 'UFILE (LIST 
		  (IMPLODE(APPEND
			  (EXPLODE(CADR(STATUS UNAME)))
			  (CDDR(EXPLODE(GENSYM)))))
		   'FTP)))
	t t)
	(APPLY 'CRUNIT (LIST 'DSK (STATUS UDIR)))
	)